home *** CD-ROM | disk | FTP | other *** search
/ HyperLib 1997 Winter - Disc 1 / HYPERLIB-1997-Winter-CD1.ISO.7z / HYPERLIB-1997-Winter-CD1.ISO / オンラインウェア / UTIL / Alpha 6.5.sit / Tcl / SystemCode / modes.tcl < prev    next >
Text File  |  1996-08-15  |  27KB  |  964 lines
  1. # (nowrap)
  2. # New modes can be specified by appending to the following vars. (nowrap)
  3. # are no longer any procs such as 'setTextMode' etc.
  4.  
  5.  
  6.  
  7. #================================================================================
  8. # The next two procs are called by Alpha to handle the mode flags popup menu.
  9. #================================================================================
  10.  
  11. proc getModeValuesAlpha {} {
  12.  
  13.     getWinInfo blah
  14.     lappend m "Mac" [expr {$blah(platform) == "mac"}]
  15.     lappend m "UNIX" [expr {$blah(platform) == "unix"}]
  16.     lappend m "IBM" [expr {$blah(platform) == "ibm"}] {(-} 0
  17.     lappend m "MPW" [expr {$blah(state) == "mpw"}]
  18.     lappend m "Think" [expr {$blah(state) == "think"}]
  19.     lappend m "None" [expr {$blah(state) == "none"}] {(-} 0
  20.     lappend m "Read Only" $blah(read-only) {(-} 0
  21.     lappend m "Tab Size" 0
  22.     return $m
  23. }
  24.  
  25.  
  26. proc setModeVarAlpha {var} {
  27.     global mode allFlags modeVars modifiedModeVars
  28.     global ${mode}modeVars
  29.     
  30.     set var [string tolower $var]
  31.     switch $var {
  32.         "unix"      -
  33.         "mac"       -
  34.         "ibm"       { setWinInfo platform $var }
  35.         "mpw"       -
  36.         "think"     -
  37.         "none"      { setWinInfo state $var }
  38.         "tab size"  {
  39.             getWinInfo arr
  40.             if {![catch {prompt "New tab size?" $arr(tabsize)} res]} {
  41.                 setWinInfo tabsize $res
  42.             }
  43.         }
  44.         "read only" { 
  45.             getWinInfo b
  46.             setWinInfo read-only [expr -1 * ($b(read-only) - 1)]}
  47.     }
  48.     return
  49. }
  50.  
  51. proc modeOptions {menu var} {
  52.     if {![llength [winNames]]} {
  53.         alertnote "No window!"
  54.         return
  55.     }
  56.     switch $var {
  57.         "flags"         modifyModeFlags
  58.         "menus"         setModeMenus
  59.         "editPrefs"     editCurrentModePrefs
  60.         "loadPrefs"     sourceCurrentModePrefs
  61.         "describeMode"  describeMode
  62.         "change"        changeModeDialog
  63.     }
  64. }
  65.  
  66. #===============================================================================
  67.  
  68. proc changeModeDialog {} {
  69.     global mode modeMenus
  70.     
  71.     set nmode [listpick -p "Mode:" -L $mode [lsort -ignore [array names modeMenus]]]
  72.     newMode $nmode
  73. }
  74.  
  75. #================================================================================
  76.  
  77. # Can be used to add new mode-specific flags and variables (see think.tcl for example).
  78. proc newModeVar {mode var val isFlag} {
  79.     global ${mode}modeVars modeVars allFlags $var
  80.     
  81.     if {![info exists modeVars] || [lsearch $modeVars $var] < 0} {
  82.         lappend modeVars $var
  83.     }
  84.     if {![info exists ${mode}modeVars($var)]} {
  85.         set ${mode}modeVars($var) $val
  86.         if {![info exists $var]} {
  87.             set $var $val
  88.         }
  89.     }
  90.     if {$isFlag && (![info exists allFlags] || ([lsearch $allFlags $var] < 0))} {
  91.         lappend allFlags $var
  92.     }
  93. }
  94.  
  95. #================================================================================
  96.  
  97. proc stringColorProc {flag} {
  98.     global $flag mode
  99.     
  100.     if {[set $flag] == "none"} {
  101.         set $flag "foreground"
  102.     }
  103.     if {$flag == "stringColor"} {
  104.         regModeKeywords -a -s $stringColor $mode
  105.     } elseif {$flag == "commentColor"} {
  106.         regModeKeywords -a -c $commentColor $mode
  107.     } elseif {$flag == "funcColor"} {
  108.         regModeKeywords -a -f $funcColor $mode
  109.     } elseif {$flag == "bracesColor"} {
  110.         regModeKeywords -a -I $bracesColor $mode
  111.     } elseif {($flag == "keywordColor") || ($flag == "sectionColor")} {
  112.         alertnote "Change in keyword color will take effect after Alpha restarts."
  113.         return
  114.     }
  115.     centerRedraw
  116. }
  117.  
  118. #================================================================================
  119.  
  120. proc saveVarValues {} {
  121.     global HOME modeMenus
  122.     if {[askyesno "Save variables and values to ¥"$HOME:alphaFlags.tcl¥"?"] == "yes"} {
  123.         set lines {}
  124.         foreach m [lsort -ignore [array names modeMenus]] {
  125.             global ${m}modeVars
  126.             
  127.             if {[info exists ${m}modeVars]} {
  128.                 foreach v [array names ${m}modeVars] {
  129.                     append lines "set ${m}modeVars($v)¥t¥t¥{[set ${m}modeVars($v)]¥}¥r"
  130.                 }
  131.                 append lines "¥r"
  132.             }
  133.         }
  134.         
  135.         append lines "¥r¥r"
  136.         global allFlags allVars
  137.         set vars [lsort [concat $allFlags $allVars]]
  138.         eval global $vars
  139.         foreach f $vars {
  140.             append lines "set $f¥t¥t¥{[set $f]¥}¥r"
  141.         }
  142.  
  143.         set fd [open "$HOME:alphaFlags.tcl" "w"]
  144.         puts $fd $lines
  145.         close $fd
  146.         message "New '$HOME:alphaFlags.tcl' written."
  147.     }
  148. }
  149.  
  150. #================================================================================
  151.  
  152. proc setWinMode name {
  153.     global winModes ModeSuffixes
  154.     set nm [file tail $name]
  155.     if {[set first [string last " <" $nm]] >= 0} {
  156.         set rname [string range $nm 0 [expr $first - 1]]
  157.     } else {
  158.         set rname $nm
  159.     }
  160.     case $rname in $ModeSuffixes
  161.     set winModes($name) $winMode
  162. }
  163.  
  164.  
  165. # Called from alphs in response to the mode popup.
  166. proc newMode mode {
  167.     global winModes modeProcs
  168.     
  169.     changeMode $mode
  170.     if {[catch {car [winNames -f]} name]} return
  171.     set winModes($name) $mode
  172.     centerRedraw
  173. }
  174.  
  175.  
  176. proc deactivateHook name {
  177. }
  178.  
  179. proc suspendHook name {
  180.     global iconifyOnSwitch
  181.     global suspIconed
  182.     if {$iconifyOnSwitch} {
  183.         set wins [winNames -f]
  184.         set suspIconed ""
  185.         foreach win $wins {
  186.             if {![icon -f "$win" -q]} {
  187.                 lappend suspIconed $win
  188.                 icon -f "$win" -t
  189.             }
  190.         }
  191.         set suspIconed [lreverse $suspIconed]
  192.     }
  193. }
  194.  
  195.  
  196. set killCompilerErrors 0
  197.  
  198. proc resumeHook name {
  199.     global iconifyOnSwitch resumeRevert suspIconed killCompilerErrors
  200.  
  201.     if {$killCompilerErrors} {
  202.         set wins [winNames -f]
  203.         if {[set res [lsearch $wins "*Compiler Errors*"]] >= 0} {
  204.             bringToFront [lindex $wins $res]
  205.             killWindow
  206.         }
  207.     }
  208.     
  209.     if {$iconifyOnSwitch && [info exists suspIconed]} {
  210.         set wins [winNames -f]
  211.         foreach win $suspIconed {
  212.             icon -f "$win" -o
  213.         }
  214.         unset suspIconed
  215.     }
  216.     if {$resumeRevert} {
  217.         set resumeRevert 0
  218.         revert
  219.     }
  220. }
  221.  
  222.  
  223.  
  224. # Handles dynamically adding and deleting window names from menu.
  225. proc addWinName name {
  226.     global winNameToNum winMenu winNumToName
  227.     
  228.     for {set i 0} {$i<100} {incr i} {
  229.         if {[catch {set nm $winNumToName($i)} res] == "1"} {
  230.             regexp {[^:]*$} $name nm
  231.             if {$i < 10} {
  232.                 addMenuItem -m -l "/$i" $winMenu $nm
  233.             } else {
  234.                 addMenuItem -m -l "" $winMenu $nm
  235.             }
  236.             set winNumToName($i) $name
  237.             set winNameToNum($name) $i
  238.             return
  239.         }
  240.     }
  241. }
  242.  
  243. proc removeWinName name {
  244.     global winNameToNum winNumToName winMenu
  245.     
  246.     set num $winNameToNum($name)
  247.     unset winNumToName($num)
  248.     unset winNameToNum($name)
  249.     regexp {[^:]*$} $name nm
  250.     deleteMenuItem -m $winMenu $nm
  251. }
  252.  
  253.  
  254. proc menuWin {menu name} {
  255.     global winNameToNum
  256.  
  257.     set nms [array names winNameToNum]
  258.  
  259.     if {[lsearch $nms "*$name"] < 0} {
  260.         $name
  261.         return
  262.     }
  263.  
  264.     foreach nm $nms {
  265.         if {[string match *$name $nm] == "1"}  {
  266.             bringToFront $name
  267.             if [icon -q] { icon -f $name -o }
  268.             return
  269.         }
  270.     }
  271.     return "normal"
  272. }
  273.  
  274.  
  275. # Do not move 'displayMode' calls!
  276. proc changeMode {newMode} {
  277.     global lastMode modeMenus dummyProc mode seenMode PREFS globalMenus_curr
  278.     
  279.     set lastMode $mode
  280.     set mode $newMode
  281.     if {$lastMode == $mode} {
  282.         catch {displayMode $newMode}
  283.         return
  284.     }
  285.  
  286.     floatShowHide off $lastMode
  287.     
  288.     # Used to be after the modeVar stuff. Why?
  289.     if {[info exists dummyProc($mode)]} { $dummyProc($mode) }
  290.  
  291.     global ${mode}modeVars
  292.     if {[info exists ${mode}modeVars]} {
  293.         foreach v [array names ${mode}modeVars] {
  294.             global $v
  295.             set $v [set ${mode}modeVars($v)]
  296.         }
  297.     }
  298.  
  299.     if {[info exists modeMenus($lastMode)]} {
  300.         foreach m $modeMenus($lastMode) {
  301.             if {[lsearch $globalMenus_curr $m] < 0} {
  302.                 global $m
  303.                 catch {removeMenu [set $m]}
  304.             }
  305.         }
  306.     }
  307.     if {[info exists modeMenus($mode)]} {
  308.         foreach m $modeMenus($mode) {
  309.             catch {$m}
  310.             global $m
  311.             catch {insertMenu [set $m]}
  312.         }
  313.     }
  314.     
  315.     if {![info exists seenMode($mode)]} {
  316.         if {[file exists "$PREFS:${mode}Prefs.tcl"]} {
  317.             if {[catch {source "$PREFS:${mode}Prefs.tcl"}]} {
  318.                 alertnote "Your preferences file '${mode}Prefs.tcl has an error."
  319.             } else {
  320.                 set seenMode($mode) 1
  321.             }
  322.         }
  323.     }
  324.     floatShowHide on $mode
  325.         
  326.     catch {displayMode $newMode}
  327. }
  328.  
  329.  
  330. proc setModeMenus {} {
  331.     global mode modeMenus menus modifiedModeMenus globalMenus_curr
  332.  
  333.     set ms [listpick -p "Pick menus for mode '$mode':" -l -L $modeMenus($mode) [lsort $menus]]
  334.     set modeMenus($mode) $ms
  335.  
  336.     lappend modifiedModeMenus $mode
  337.  
  338.     foreach m $menus {
  339.         if {[lsearch $globalMenus_curr $m] < 0} {
  340.             global $m
  341.             catch {removeMenu [set $m]}
  342.         }
  343.     }
  344.  
  345.     foreach m $ms {
  346.         global $m
  347.         catch {$m}
  348.         catch {insertMenu [set $m]}
  349.     }
  350. }
  351.  
  352.  
  353. #=============================================================================
  354. # Hook procs recognized: "openHook", "closeHook", "activateHook", "deactivateHook", 
  355. #                        "suspendHook", "saveasHook", "saveHook", and "resumeHook".
  356. #=============================================================================
  357.  
  358. if {![info exists winActive]} {set winActive ""}
  359.  
  360. # Event hooks - set specific modes when files opened.
  361.  
  362.  
  363. proc openHook name {
  364.     global winModes autoMark mode screenHeight screenWidth forceMainScreen recentFiles recentFilesCount 
  365.  
  366.     changeMode $winModes($name)
  367.     if {$name == {*Toolserver shell*}} startMPW
  368.     addWinName $name
  369.     message ""
  370.  
  371.     if {![catch {getFileInfo $name info}]} {
  372.         if {$info(creator) == {ttxt}} {
  373.             setWinInfo dirty 0
  374.         }
  375.         if {$info(type) == {ttro}} {
  376.             catch {setWinInfo read-only 1}
  377.             message "Read-only!"
  378.         }
  379.     }
  380.  
  381.     global ${mode}modeVars
  382.     
  383.     if {$forceMainScreen} {
  384.         set geo [getGeometry]
  385.         set l [lindex $geo 0]; set t [lindex $geo 1]; set w [lindex $geo 2]; set h [lindex $geo 3]; 
  386.         if {($l < 0) || ($t < 35) || ([expr $l + $w] > $screenWidth) || ([expr $t + $h + 18] > $screenHeight)} {
  387.             singlePage
  388.         }
  389.     }
  390.     getWinInfo arr
  391.     if {[info exists ${mode}modeVars(autoMark)] && [set ${mode}modeVars(autoMark)] && !$arr(read-only) && ![llength [getNamedMarks -n]]} {
  392.         markFile
  393.     }
  394.     
  395.     if {[string match "*Preferences*defs.tcl" $name]} {setWinInfo read-only 1}
  396.     
  397.     pushRecent $name 
  398. }
  399.  
  400.  
  401. # full pathname, called *before* file actually saved
  402. proc saveHook name {
  403.     global backup backExtension backDir mode
  404.     
  405.     if {($mode == "C") || ($mode == "C++")} {catch {modified}}
  406.  
  407.     if ($backup) {
  408.         set dir [uplevel #0 {substituteVars $backDir}]
  409.             
  410.         if {![string length $dir]} {
  411.             set dir [file dirname $name]
  412.         }
  413.         if {![file exists $dir]} {
  414.             if {[askyesno "Create backup dir '$dir'?"] == "yes"} {
  415.                 mkdir $dir
  416.             }
  417.         }
  418.         catch {rm $dir:[file tail $name]$backExtension}
  419.         catch {cp $name $dir:[file tail $name]$backExtension}
  420.     }
  421. }
  422.  
  423.  
  424. # full pathname, called *after* file saved.
  425. proc savePostHook name {
  426.     global savePostHooks
  427.     
  428.     if {[info exists savePostHooks]} {
  429.         foreach hook $savePostHooks {
  430.             catch {$hook $name}
  431.         }
  432.     }
  433. }
  434.  
  435.  
  436. proc revertToBackup {} {
  437.     global backup backExtension backDir winModes 
  438.  
  439.     set fname [car [winNames -f]]
  440.     set dir [uplevel #0 {substituteVars $backDir}]
  441.     set bname "$dir:[file tail $fname]$backExtension"
  442.     if {![file exists $bname]} {
  443.         message "Backup file '$bname' does not exist"
  444.         return
  445.     }
  446.     
  447.     if {[askyesno "Revert to backup dated '[join [mtime [file mtime $bname]]]'?"] == "yes"} {
  448.         killWindow
  449.         
  450.         edit $bname
  451.         saveAs -f $fname
  452.     }
  453. }
  454.  
  455.  
  456.  
  457. # Clean up the mark stack.
  458. proc closeHook name {
  459.     global markStack winModes winActive
  460.  
  461.     unset winModes($name)
  462.     if [llength $markStack] {
  463.         set markStack [removePat $markStack $name*]
  464.     }
  465.     removeWinName $name
  466.  
  467.     if {[set ind [lsearch $winActive $name]] >= 0} {
  468.         set winActive [lreplace $winActive $ind $ind]
  469.     }
  470.  
  471.     catch {unset winModes($name)}
  472.  
  473.     if {![llength [winNames]]} {
  474.         changeMode {}
  475.     }
  476. }
  477.  
  478.  
  479. proc saveasHook {oldName newName} {
  480.     global winModes winActive
  481.     if {$oldName == $newName} return
  482.     removeWinName $oldName
  483.     addWinName $newName
  484.     setWinMode $newName
  485.     changeMode $winModes($newName)
  486.     
  487.     pushRecent $newName
  488.     
  489.     if {[set ind [lsearch $winActive $oldName]] >= 0} {
  490.         set winActive [lreplace $winActive $ind $ind]
  491.     }
  492.     set winActive [linsert $winActive 0 $newName]
  493.     catch {unset winModes($oldName)}
  494. }
  495.  
  496. if {![info exists actives]} {set actives 0}
  497.  
  498. # and, install a new 'winActive' patch , to 'activateHook':
  499.  
  500. proc activateHook name {
  501.     global winModes winActive
  502.  
  503.     if {![info exists winModes($name)]} {
  504.         setWinMode $name
  505.     }
  506.     changeMode $winModes($name)
  507.  
  508.     if {[set ind [lsearch $winActive $name]] == -1} {
  509.         set winActive [linsert $winActive 0 $name]
  510.         return
  511.     }
  512.     if {$ind >= 1} {
  513.         set winActive [lreplace $winActive $ind $ind]
  514.         set winActive [linsert $winActive 0 $name]
  515.     }
  516.  
  517. }
  518.  
  519.  
  520. proc dirtyHook {name dirty} {
  521.     global winMenu
  522.     markMenuItem $winMenu [file tail $name] $dirty "ﾗ"
  523. }
  524.  
  525.  
  526. proc quitHook {} {
  527.     global quitHooks PREFS
  528.     if {[file exists "$PREFS:ftpTmp"]} {
  529.         catch {rm "$PREFS:ftpTmp:*"}
  530.     }
  531.     saveModifiedVars
  532.     if {[info exists quitHooks]} {
  533.         foreach item $quitHooks {
  534.             $item
  535.         }
  536.     }
  537. }
  538.  
  539.  
  540. proc saveModifiedVars {} {
  541.     global modifiedVars modifiedModeVars modifiedArrVars modifiedModeMenus modeMenus prefDefs recentFilesSave recentFiles
  542.  
  543.     if {[llength $modifiedVars] || [llength $modifiedArrVars] || [llength $modifiedModeVars] || [llength $modifiedModeMenus]} {
  544.         foreach f [removeDups $modifiedModeMenus] {
  545.             addArrDef modeMenus $f $modeMenus($f)
  546.         }
  547.         foreach f [removeDups $modifiedArrVars] {
  548.             global $f
  549.             foreach ind [array names $f] {
  550.                 addArrDef $f $ind [set ${f}($ind)]
  551.             }
  552.         }
  553.         foreach f [removeDups $modifiedVars] {
  554.             global $f
  555.             addDef $f [set $f]
  556.         }
  557.         foreach f [removeDups $modifiedModeVars] {
  558.             set nm [lindex $f 0]
  559.             set mode [lindex $f 1]
  560.             global $mode
  561.             addArrDef [set mode] $nm [set [set mode]($nm)]
  562.         }
  563.     }
  564.     
  565.     if {[info exists recentFiles]} {
  566.         addDef recentFilesSave $recentFiles
  567.     }
  568.  
  569.     set modifiedVars {}
  570.     set modifiedArrVars {}
  571.     set modifiedModeVars {}
  572.     set modifiedModeMenus {}
  573. }
  574.  
  575. #================================================================================
  576.  
  577. proc describeMode {} {
  578.     global mode ModeSuffixes modeMenus
  579.     global ${mode}modeVars
  580.     
  581.     set text "¥r¥tMODE $mode¥r¥r"
  582.     set suffs ""
  583.     set first 1
  584.     foreach suf $ModeSuffixes {
  585.         if {([llength $suf] == 3) && ([lindex $suf 1] == "winMode") && ([lindex $suf 2] == $mode)} {
  586.             if {$first} {
  587.                 lappend suffs $last
  588.                 set first 0
  589.             } else {
  590.                 append suffs ", $last"
  591.             }
  592.         }
  593.         set last $suf
  594.     }
  595.     append text "Mode filepats: $suffs¥r¥r"
  596.     
  597.     set first 1
  598.     append text "Mode menus: "
  599.     if {[info exists modeMenus($mode)]} {
  600.         foreach m $modeMenus($mode) {
  601.             if $first {
  602.                 set first 0
  603.                 lappend text $m
  604.             } else {
  605.                 append text ", $m"
  606.             }
  607.         }
  608.     }
  609.     append text "¥r¥r"
  610.  
  611.     append text "Mode-specific variables:¥r"
  612.     if {[info exists ${mode}modeVars]} {
  613.         foreach v [lsort [array names ${mode}modeVars]] {
  614.             append text [format "¥t%-20s: ¥"%s¥"¥r" $v [set ${mode}modeVars($v)]]
  615.         }
  616.     }
  617.  
  618.  
  619.     set etext "¥rMode-independent bindings:¥r"
  620.     append text "¥rMode-specific bindings:¥r"
  621.     foreach b [split [bindingList] "¥r"] {
  622.         set lst [lindex $b end]
  623.         if {$lst == $mode} {
  624.             append text "¥t$b¥r"
  625.         } elseif {[lsearch [lsort -ignore [array names modeMenus]] $lst] < 0} {
  626.             append etext "¥t$b¥r"
  627.         }
  628.     }
  629.     new -n "* <$mode> MODE *"
  630.     insertText $text$etext
  631.     goto 0
  632.     
  633.     setWinInfo dirty 0
  634. }
  635.  
  636.  
  637. proc globalOptions {menu item {is_mode ""}} {
  638.     global flagPrefs varPrefs maxT tcl_var_procs modifiedVars modeMenus mode
  639.  
  640.     updateMisc
  641.     if {[string length $is_mode]} {
  642.         set args {}
  643.         set nvars [llength $item]
  644.         lappend args [list "Page 1" $menu [lrange $item 0 [expr ($nvars / 2) - 1]]]
  645.         lappend args [list "Page 2" {} [lrange $item [expr ($nvars / 2)] end]]
  646.     } else {
  647.         if {$item == "menus"} {
  648.             global menus globalMenus_curr
  649.             
  650.             set globalMenus_curr [listpick -p "Select global menus:" -l -L $globalMenus_curr  [lsort -ignore $menus]]
  651.             foreach m $menus {
  652.                 global $m
  653.                 if {[info exists $m]} {
  654.                     catch "removeMenu [set $m]"
  655.                 }
  656.             }
  657.             lappend    modifiedVars globalMenus_curr
  658.             foreach    m $globalMenus_curr    {
  659.                 catch $m
  660.                 insertMenu [set    $m]
  661.             }
  662.             if {[info exists modeMenus($mode)]}    {
  663.                 foreach    m $modeMenus($mode)    {
  664.                     catch $m
  665.                     insertMenu [set    $m]
  666.                 }
  667.             }
  668.             return
  669.         }
  670.         if {$item != "flags"} {
  671.             return [$item]
  672.         }
  673.         
  674.         set args {}
  675.         foreach nm [array names flagPrefs] {
  676.             lappend args [list $nm $flagPrefs($nm) $varPrefs($nm)]
  677.         }
  678.     }
  679.     
  680.     set left 20
  681.     
  682.     set height [expr 500 + 60]
  683.  
  684.     set names {}
  685.     set maxT 0
  686.     foreach arg [lsort $args] {
  687.         if {[llength $arg] != 3} {error "Bad structure"}
  688.         lappend names [lindex $arg 0]
  689.         set flags [lindex $arg 1]
  690.         set vars [lindex $arg 2]
  691.         append editItems " " $flags " " $vars
  692.         append cmd " -n ¥{[lindex $arg 0]¥} " [dialSet $flags $vars]
  693.     }
  694.  
  695.     set height [expr $maxT + 30]
  696.     set buttons [concat -b OK $left [expr $height-30] [expr $left + 60] [expr $height-10] -b Cancel [expr $left + 100] [expr $height-30] [expr $left + 160] [expr $height-10]]
  697.     global blah
  698.     set res [eval [concat dialog -w 480 -h $height -t "Preferences:" 60 10 140 30 $buttons [list -m [concat [list [lindex $names 0]] $names] 150 10 305 30]  $cmd]]
  699.  
  700.     set changed {}
  701.     
  702.     if {[lindex $res 0]} {
  703.         set res [lrange $res 3 end]
  704.         
  705.         if {[string length $is_mode]} {
  706.             return $res
  707.         }
  708.         
  709.         foreach item $editItems {
  710.             set val [lindex $res 0]
  711.             set res [lrange $res 1 end]
  712.             
  713.             global $item
  714.             if {[set $item] != $val} {
  715.                 set $item $val
  716.                 if {[info exists tcl_var_procs($item)]} {
  717.                     $tcl_var_procs($item) $item
  718.                 }
  719.                 lappend modifiedVars $item
  720.             }
  721.         }
  722.     } else {
  723.         error "Cancel chosen"
  724.     }
  725. }
  726.  
  727.  
  728. proc modifyModeFlags {} {
  729.     global mode invisibleModeVars modifiedModeVars
  730.     global ${mode}modeVars
  731.     global allFlags tcl_var_procs
  732.     global ${mode}invisibleModeVars
  733.  
  734.     if {![llength [winNames]]} {
  735.         alertnote "No window!"
  736.         return
  737.     }
  738.  
  739.     set flags {}
  740.     set vars {}
  741.     
  742.     if {[info exists ${mode}modeVars]} {
  743.  
  744.         foreach v [lsort [array names ${mode}modeVars]] {
  745.             if {[info exists invisibleModeVars($v)] ¥
  746.             || [info exists ${mode}invisibleModeVars($v)]} continue
  747.             
  748.             if {[lsearch $allFlags $v] >= 0} {
  749.                 lappend flags $v
  750.             } else {
  751.                 lappend vars $v
  752.             }
  753.         }
  754.         set flags [lsort $flags]
  755.         set vars [lsort $vars]
  756.         
  757.         if {$mode == "TeX"} {
  758.             set res [globalOptions $flags $vars "yes"]
  759.         } else {
  760.             set res [modeDialog $flags $vars]
  761.         }
  762.         
  763.         foreach flag [concat $flags $vars] {
  764.             global $flag
  765.             set val [lindex $res 0]
  766.             set res [lrange $res 1 end]
  767.             
  768.             if {[set $flag] != $val} {
  769.                 set $flag $val
  770.                 set ${mode}modeVars($flag) $val
  771.                 lappend modifiedModeVars [list $flag ${mode}modeVars]
  772.  
  773.                 if {[info exists tcl_var_procs($flag)]} {
  774.                     $tcl_var_procs($flag) $flag
  775.                 }
  776.             }
  777.         }
  778.         updateSuffixes
  779.     }
  780. }
  781.  
  782. proc modifyModeString {flag} {
  783.     global stringColor mode
  784.     
  785.     regModeKeywords -a -s $stringColor $mode
  786.     centerRedraw
  787. }
  788.  
  789. # Suffixes used to initially determine mode for new window.
  790. proc updateSuffixes {} {
  791.     global ModeSuffixes modeMenus filepats
  792.  
  793.     set ModeSuffixes { default { set winMode Text } }
  794.     foreach m [lsort -ignore [array names modeMenus]] {
  795.         if {[info exists filepats($m)]} {
  796.             lappend ModeSuffixes $filepats($m) "set winMode $m"
  797.         }
  798.     }
  799. }
  800.  
  801. #===============================================================================
  802. proc addMode {m dummy suffs menus} {
  803.     global dummyProc modeMenus filepats
  804.     
  805.     set modeMenus($m) $menus
  806.     if {[string length $dummy]} {set dummyProc($m) $dummy}
  807.     set filepats($m) $suffs
  808. }
  809.  
  810.  
  811. proc addMenu {m} {
  812.     global menus
  813.     if { ![info exists menus] || [lsearch -exact $menus $m] == -1 } {
  814.         lappend menus $m
  815.     }
  816. }
  817.  
  818.  
  819. #===============================================================================
  820.  
  821. ####################################
  822. #                                   #
  823. #    A Few Small    Mode Definitions   #
  824. #                                   #
  825. ####################################
  826.  
  827. if !$alphaLite {
  828.     addMode MPW {} {"*Toolserver¥ *"} {}
  829.     addMode Diff {} {} {}
  830.  
  831.     addMode PS {} {*.ps} {}
  832.     newModeVar PS prefixString {% } 0 
  833.     set PSKeyWords {
  834.         def begin end dict load
  835.         exec if ifelse for repeat loop exit stop stopped countexecstack execstack quit start
  836.         gsave grestore grestoreall initgraphics 
  837.         newpath erasepage fill eofill stroke image imagemask showpage copypage
  838.     }
  839.     if {[info exists PSwords]} {set PSKeyWords [concat $PSKeyWords $PSwords]}
  840.     regModeKeywords -e {%} -m {/}  -c red -k blue PS $PSKeyWords -i "¥}" -i "¥{" -i {[} -i {]} -I green
  841.     unset PSKeyWords
  842. }
  843.  
  844. #================================================================================
  845. addMode Brws dummyBrws {} {}
  846. #================================================================================
  847. addMode Text {} {default} {}
  848. newModeVar Text leftFillColumn {0} 0
  849. newModeVar Text suffixString { <--} 0
  850. newModeVar Text prefixString {> } 0
  851. newModeVar Text fillColumn {75} 0
  852. newModeVar Text wordWrap {1} 1
  853. newModeVar Text wordBreak {¥w+} 0
  854. newModeVar Text wordBreakPreface {(¥W)} 0
  855. newModeVar Text wrapBreak {[¥w_]+} 0
  856. newModeVar Text wrapBreakPreface {([^¥w_])} 0
  857. newModeVar Text autoMark    0   1
  858.  
  859. ##############################
  860. #                             #
  861. #    Things done    at startup     #
  862. #                             #
  863. ##############################
  864.  
  865. # For quithook
  866. set modifiedVars        {}
  867. set modifiedArrVars     {}
  868. set modifiedModeVars    {}
  869. set modifiedModeMenus   {}
  870.  
  871. # ???
  872. set modeVars             {funcExpr wrapBreakPreface wrapBreak wordBreakPreface wordBreak}
  873.  
  874. # 'mode' is nothing when we start up.
  875. set mode                 {}
  876. set lastMode            0
  877. set reverting             {}
  878.  
  879. # Used on modified mode flags.
  880. set tcl_var_procs(stringColor) "stringColorProc"
  881. set tcl_var_procs(commentColor) "stringColorProc"
  882. set tcl_var_procs(keywordColor) "stringColorProc"
  883. set tcl_var_procs(funcColor) "stringColorProc"
  884. set tcl_var_procs(sectionColor) "stringColorProc"
  885. set tcl_var_procs(bracesColor) "stringColorProc"
  886.  
  887.  
  888. ##############################################################
  889. #                                                             #
  890. #    Used to    split flags    over different preferences panels.     #
  891. #                                                             #
  892. ##############################################################
  893. set flagPrefs(Backups)         {backup}
  894. set varPrefs(Backups)         {backDir backExtension}
  895. set flagPrefs(Gui)             {blinkingCursor blockCursor coloring dragAndDrop iconifyOnSwitch intelCutPaste lockStatus showInvisibles smallMenuFont sortFuncsMenu } 
  896. set varPrefs(Gui)              {defaultFont fontSize tabSize}
  897. set flagPrefs(Printer)         {printHeader printHeaderFullPath printHeaderTime}
  898. set varPrefs(Printer)         {bottomMargin printerFont printerFontSize topMargin leftMargin}
  899. set flagPrefs(Tags)         {}
  900. set varPrefs(Tags)             {funcPar tagFile}
  901. set flagPrefs(Window)         {autoHScroll forceMainScreen horScrollBar moveInsertion powerThumb sortedIsDefault}
  902. set varPrefs(Window)         {defHeight defLeft defTop defWidth }
  903. set flagPrefs(Tiling)         {}
  904. set varPrefs(Tiling)         {numWinsToTile horMargin tileHeight tileProportion tileLeft tileMargin tileTop tileWidth }
  905. set flagPrefs(Wrapping)     {}
  906. set varPrefs(Wrapping)         {fillColumn leftFillColumn paraColumn wrapLow wrapHigh}
  907.  
  908. proc updateMisc {} {
  909.     uplevel #0 {
  910.         set flagPrefs(Miscellaneous) {}
  911.         foreach f $allFlags {
  912.             if {([lsearch $modeVars $f] < 0) && ([lsearch $flagPrefs(Tiling) $f] < 0) && ([lsearch $flagPrefs(Backups) $f] < 0) && ([lsearch $flagPrefs(Gui) $f] < 0) && ([lsearch $flagPrefs(Printer) $f] < 0) && ([lsearch $flagPrefs(Tags) $f] < 0) && ([lsearch $flagPrefs(Window) $f] < 0) && ([lsearch $flagPrefs(Wrapping) $f] < 0)} {
  913.                 lappend flagPrefs(Miscellaneous) $f
  914.             }
  915.         }
  916.         
  917.         set varPrefs(Miscellaneous) {}
  918.         foreach f $allVars {
  919.             if {([lsearch $modeVars $f] < 0) && ([lsearch $varPrefs(Tiling) $f] < 0) && ([lsearch $varPrefs(Backups) $f] < 0) && ([lsearch $varPrefs(Gui) $f] < 0) && ([lsearch $varPrefs(Printer) $f] < 0) && ([lsearch $varPrefs(Tags) $f] < 0) && ([lsearch $varPrefs(Window) $f] < 0) && ([lsearch $varPrefs(Wrapping) $f] < 0)} {
  920.                 lappend varPrefs(Miscellaneous) $f
  921.             }
  922.         }
  923.     }
  924. }
  925.  
  926.  
  927. #####################################################
  928. #                                                    #
  929. #    Find out which modes and menus are out there.    #
  930. #                                                    #
  931. #####################################################
  932.  
  933. set startingUp 1
  934. if {![catch {glob "$HOME:Tcl:Modes:*Mode.tcl"} files]} {
  935.     foreach f $files {
  936.         if {[catch {source $f}]} {
  937.             lappend problems [file tail $f]
  938.         }
  939.     }
  940. }
  941. if {![catch {glob "$HOME:Tcl:Menus:*Menu.tcl"} files]} {
  942.     foreach f $files {
  943.         if {[catch {source $f}]} {
  944.             lappend problems [file tail $f]
  945.         }
  946.     }
  947. }
  948. if {[info exists problems]} {
  949.     alertnote "Problems loading files '$problems'"
  950.     unset problems
  951. }
  952. if {[info exists menus]} {
  953.     set menus [removeDups $menus]
  954. }
  955. set startingUp 0
  956.  
  957. foreach    m [lsort -ignore [array names modeMenus]] {
  958.     addMenuItem    -m modePrefs $m
  959. }
  960.  
  961. addMode Text {} {} {}
  962. updateSuffixes
  963.  
  964.